home *** CD-ROM | disk | FTP | other *** search
/ Aminet 6 / Aminet 6 - June 1995.iso / Aminet / dev / debug / MemWatcher1_0.lha / memwatcher / txt / MemWatcher.mod
Encoding:
Text File  |  1995-03-22  |  11.3 KB  |  419 lines
  1. |##########|
  2. |#MAGIC   #|DEMKANJI
  3. |#PROJECT #|"MemWatcher"
  4. |#PATHS   #|"StdProject"
  5. |#FLAGS   #|xx---x--xx----x-----------------
  6. |#USERSW  #|--------------------------------
  7. |#USERMASK#|--------------------------------
  8. |#SWITCHES#|x----xxxxx-xx---
  9. |##########|
  10. MODULE MemWatcher;
  11. |
  12. | MemWatcher, the Workbench surrogate for drip.
  13. |
  14. | Version 1.0
  15. | Tested with Enforcer, Mungwall, MemWatcher
  16. | No known errors
  17. |
  18. | (c)1995 F.Brandau
  19. |
  20. FROM Intuition   IMPORT WindowGrp,ScreenGrp,BorderGrp,BorderList,DrawInfoPtr,
  21.                         GetScreenDrawInfo,DrawBorder,IntuiTextGrp,
  22.                         IntuiTextLength,PrintIText,GadgetGrp,boolGadget;
  23. FROM Graphics    IMPORT DrawGrp,jam1,PenArrayPtr,ScrollRaster,SetAPen,EraseRect;
  24. FROM Exec        IMPORT MemGrp,MsgPortGrp;
  25. FROM Heap        IMPORT New;
  26. FROM Conversions IMPORT IntToString,StringToInt;
  27. FROM Strings     IMPORT SysStr,Str;
  28. FROM Dos         IMPORT Delay,FileLockPtr,GetProgramDir,CurrentDir;
  29. FROM Icon        IMPORT DiskObjectGrp,ToolTypeGrp;
  30. |
  31. | Exceptions
  32. |
  33. EXCEPTION
  34.   ScreenNotLocked  : "Unable to lock screen.";
  35.   WindowNotOpen    : "Window failed to open.";
  36.   NoDrawInfo       : "Could not get Draw Info.";
  37. |
  38. | Constants
  39. |
  40. CONST
  41.   Vers             = "$VER: MemWatcher 1.0 (21.3.95)";
  42. |
  43. | Variables
  44. |
  45. VAR
  46.   Version          : STRING(50);
  47.   |
  48.   | ToolTypes
  49.   |
  50.   PubScreen        : STRING(80);
  51.   DisplayWidth     : INTEGER                          := 200;
  52.   Time             : INTEGER                          := 10;
  53.   XPos             : INTEGER                          := 100;
  54.   YPos             : INTEGER                          := 100;
  55.   FileLckPtr       ,
  56.   OldDir           : FileLockPtr;
  57.   DiskObjPtr       : DiskObjectPtr;
  58.   SysText          : SysStringPtr;
  59.   ToolTypeTxt      : STRING(80);
  60.   |
  61.   | Screen colours
  62.   |
  63.   MainDrawInfo     : DrawInfoPtr;
  64.   PenPtr           : PenArrayPtr;
  65.   |DetailPen        ,
  66.   BlockPen         ,
  67.   |TextPen          ,
  68.   ShinePen         ,
  69.   ShadowPen        ,
  70.   FillPen          ,
  71.   |FillTextPen      ,
  72.   |BackgroundPen    ,
  73.   HighLightTextPen : SHORTCARD;
  74.   |
  75.   | Workspace
  76.   |
  77.   MainWindow       : WindowPtr;
  78.   WorkScreen       : ScreenPtr;
  79.   FontSize         : INTEGER;
  80.   MainBorder       : BorderPtr;
  81.   oldX,oldY        : INTEGER;
  82.   BaseGadget       : Gadget;
  83.   |
  84.   | Program body
  85.   |
  86.   Msg              : IntuiMessagePtr;
  87.   EndPrg           : BOOLEAN                          := FALSE;
  88.   |
  89.   | Memory handling
  90.   |
  91.   MemBase          : LONGCARD;
  92.   OldMem           ,
  93.   MemDiff          : LONGINT;
  94.  
  95. |
  96. | Subroutine : Create and initialise border structure
  97. |
  98. PROCEDURE CreateBorder(link : BorderPtr;left,top,width,height : INTEGER):BorderPtr;
  99. |
  100. | ShadowPen and ShinePen must be provided by calling program
  101. |
  102. VAR
  103.   shine,shadow : POINTER TO Border;
  104.   shiD,shaD    : POINTER TO BorderList(6);
  105.   store        : BorderPtr;
  106.  
  107. BEGIN
  108.   New(shine);
  109.   New(shadow);
  110.   New(shiD);
  111.   New(shaD);
  112.   shiD^              := BorderList:((0,0),(0,0),(0,0),(0,0),(1,0),(1,1));
  113.   shaD^              := BorderList:((1,0),(0,0),(0,0),(0,1),(0,1),(0,0));
  114.   shiD[0].x          := width-2;
  115.   shiD[2].y          := height-1;
  116.   shiD[3].y          := height-2;
  117.   shiD[4].y          := height-2;
  118.   shaD[0].y          := height-1;
  119.   shaD[1].x          := width-1;
  120.   shaD[1].y          := height-1;
  121.   shaD[2].x          := width-1;
  122.   shaD[3].x          := width-1;
  123.   shaD[4].x          := width-2;
  124.   shaD[5].x          := width-2;
  125.   shaD[5].y          := height-2;
  126.  
  127.   shadow^            := Border:(0,0,0,0,jam1,6,NIL,NIL);
  128.   shine^             := Border:(0,0,0,0,jam1,6,NIL,NIL);
  129.  
  130.   shadow^.leftEdge   := left;
  131.   shadow^.topEdge    := top;
  132.   shadow^.frontPen   := ShadowPen;
  133.   shine^.leftEdge    := left;
  134.   shine^.topEdge     := top;
  135.   shine^.frontPen    := ShinePen;
  136.  
  137.   shadow^.xy         := shaD;
  138.   shadow^.nextBorder := shine;
  139.   shine^.xy          := shiD;
  140.  
  141.   IF link#NIL THEN
  142.     store:=link;
  143.     WHILE store^.nextBorder#NIL DO
  144.       store:=store^.nextBorder
  145.     END;
  146.     store^.nextBorder:=shadow;
  147.     RETURN(link)
  148.   ELSE
  149.     RETURN(shadow)
  150.   END
  151. END CreateBorder;
  152.  
  153. |
  154. | Subroutine : Center text into window
  155. |
  156. PROCEDURE Center(Win : WindowPtr;AtY : LONGINT;Str : STRING);
  157. VAR
  158.   Text : IntuiText;
  159. BEGIN
  160.   Text           := IntuiText:(1,2,jam1,0,0,NIL,NIL,NIL);
  161.   Text.iTextFont := Win^.wScreen^.font;
  162.   Str.data[Str.len]:=&0;
  163.   Text.iText     := Str.data'PTR;
  164.   Text.leftEdge  := (Win^.width-Win^.borderLeft-Win^.borderRight) DIV 2
  165.                     + Win^.borderLeft - IntuiTextLength(Text'PTR) DIV 2;
  166.   Text.topEdge   := AtY;
  167.   PrintIText(Win^.rPort,Text'PTR,0,0);
  168. END Center;
  169.  
  170. |
  171. | Subroutine : Scroll and update display
  172. |
  173. PROCEDURE DrawMem;
  174. VAR
  175.   mempoint : INTEGER;
  176. BEGIN
  177.   WITH MainWindow^.rPort AS Rast DO
  178.     |
  179.     | Scroll display
  180.     |
  181.     ScrollRaster(Rast,1,0,
  182.                       MainWindow^.borderLeft+2,
  183.                       MainWindow^.borderTop+1,
  184.                       INTEGER(MainWindow^.borderLeft)+2+DisplayWidth,
  185.                       MainWindow^.borderTop+101);
  186.     |
  187.     | Draw baseline
  188.     |
  189.     SetAPen(Rast,BlockPen);
  190.     FORGET WritePixel(Rast,INTEGER(MainWindow^.borderLeft)+2+DisplayWidth,MainWindow^.borderTop+51);
  191.     SetAPen(Rast,HighLightTextPen);
  192.     |
  193.     | Compute memorypoint
  194.     |
  195.     MemDiff:=LONGINT(MemBase)-LONGINT(AvailMem(MemReqSet:{}));
  196.     IF MemDiff=0 THEN
  197.       SetAPen(Rast,FillPen);
  198.       mempoint:=0
  199.     ELSE
  200.       mempoint:=INTEGER(15*LOG(REAL(ABS(MemDiff))/1000+1));
  201.       mempoint:=mempoint*(MemDiff DIV ABS(MemDiff));
  202.     END;
  203.     |
  204.     | Write memory difference
  205.     |
  206.     IF OldMem#MemDiff THEN
  207.       EraseRect(Rast,MainWindow^.borderLeft+2,
  208.                      MainWindow^.borderTop+104,
  209.                      INTEGER(MainWindow^.borderLeft)+DisplayWidth+2,
  210.                      INTEGER(MainWindow^.borderTop)+103+FontSize+6);
  211.       Center(MainWindow,MainWindow^.borderTop+107,IntToString(MemDiff));
  212.       OldMem:=MemDiff;
  213.     END;
  214.     |
  215.     | Draw memoryline
  216.     |
  217.     IF ABS(mempoint)-50>0 THEN
  218.       mempoint:=50;
  219.       SetAPen(Rast,FillPen)
  220.     END;
  221.     Move(Rast,oldX,oldY);
  222.     oldX:=INTEGER(MainWindow^.borderLeft)+2+DisplayWidth;
  223.     oldY:=MainWindow^.borderTop+51-mempoint;
  224.     Draw(Rast,oldX,oldY);
  225.   END
  226. END DrawMem;
  227.  
  228. |
  229. | Main
  230. |
  231. BEGIN
  232.   Version:=Vers;
  233.   |
  234.   | Read ToolTypes
  235.   |  currently recognized types:
  236.   |   -PubScreen name (PubScreen)
  237.   |   -XPos
  238.   |   -YPos
  239.   |   -Timebase
  240.   |   -DisplayWidth   (Display)
  241.   |
  242.   FileLckPtr := GetProgramDir();
  243.   OldDir     := CurrentDir(FileLckPtr);
  244.   DiskObjPtr := GetDiskObject("MemWatcher");
  245.   IF DiskObjPtr#NIL THEN
  246.     WITH DiskObjPtr^.toolTypes AS TTyp DO
  247.       |
  248.       | PubScreen name
  249.       |
  250.       SysText:=FindToolType(TTyp,SysStr("PubScreen"));
  251.       IF SysText#NIL THEN
  252.         PubScreen:=Str(SysText);
  253.         PubScreen.data[PubScreen.len]:=&0
  254.       END;
  255.       |
  256.       | XPos
  257.       |
  258.       SysText:=FindToolType(TTyp,SysStr("XPos"));
  259.       IF SysText#NIL THEN
  260.         ToolTypeTxt:=Str(SysText);
  261.         XPos:=StringToInt(ToolTypeTxt)
  262.       END;
  263.       |
  264.       | YPos
  265.       |
  266.       SysText:=FindToolType(TTyp,SysStr("YPos"));
  267.       IF SysText#NIL THEN
  268.         ToolTypeTxt:=Str(SysText);
  269.         YPos:=StringToInt(ToolTypeTxt)
  270.       END;
  271.       |
  272.       | Timebase
  273.       |
  274.       SysText:=FindToolType(TTyp,SysStr("Timebase"));
  275.       IF SysText#NIL THEN
  276.         ToolTypeTxt:=Str(SysText);
  277.         Time:=StringToInt(ToolTypeTxt)
  278.       END;
  279.       |
  280.       | DisplayWidth
  281.       |
  282.       SysText:=FindToolType(TTyp,SysStr("Display"));
  283.       IF SysText#NIL THEN
  284.         ToolTypeTxt:=Str(SysText);
  285.         DisplayWidth:=StringToInt(ToolTypeTxt)
  286.       END;
  287.       |
  288.       | ...
  289.       |
  290.     END;
  291.     FreeDiskObject(DiskObjPtr);
  292.     DiskObjPtr:=NIL
  293.   END;
  294.   |
  295.   | Get the current public screen
  296.   |
  297.   IF PubScreen.len=0 THEN
  298.     WorkScreen:=LockPubScreen(NIL)
  299.   ELSE
  300.     WorkScreen:=LockPubScreen(PubScreen.data'PTR)
  301.   END;
  302.   ASSERT(WorkScreen#NIL,ScreenNotLocked);
  303.   |
  304.   | Initialise colors from screen
  305.   |
  306.   MainDrawInfo:=GetScreenDrawInfo(WorkScreen);
  307.   ASSERT(MainDrawInfo#NIL,NoDrawInfo);
  308.   |
  309.   | Values for pen array taken from include/intuition/screens.h
  310.   |
  311.   PenPtr           := MainDrawInfo^.pens;
  312.   |DetailPen        := PenPtr[$0000];
  313.   BlockPen         := PenPtr[$0001];
  314.   |TextPen          := PenPtr[$0002];
  315.   ShinePen         := PenPtr[$0003];
  316.   ShadowPen        := PenPtr[$0004];
  317.   FillPen          := PenPtr[$0005];
  318.   |FillTextPen      := PenPtr[$0006];
  319.   |BackgroundPen    := PenPtr[$0007];
  320.   HighLightTextPen := PenPtr[$0008];
  321.   |
  322.   | Read current fontsize
  323.   |
  324.   FontSize:=INTEGER(WorkScreen^.font^.ySize);
  325.   |
  326.   | Open main window
  327.   |
  328.   MainWindow:=OpenWindowTags(NIL,
  329.                              left         : XPos,
  330.                              top          : YPos,
  331.                              innerWidth   : DisplayWidth + 5,
  332.                              innerHeight  : FontSize+111,
  333.                              IDCMP        : IDCMPFlagSet:{closeWindow,gadgetUp},
  334.                              customScreen : WorkScreen,
  335.                              title        : "MemWatcher".data'PTR,
  336.                              dragBar      : TRUE,
  337.                              depthGadget  : TRUE,
  338.                              closeGadget  : TRUE,
  339.                              activate     : TRUE,
  340.                              DONE
  341.                             );
  342.   ASSERT(MainWindow#NIL,WindowNotOpen);
  343.   |
  344.   | Window is open
  345.   |
  346.   UnlockPubScreen(NIL,WorkScreen);
  347.   |
  348.   | Draw window graphics
  349.   |
  350.   WITH MainWindow^.rPort AS Rast DO
  351.     MainBorder:=CreateBorder(MainBorder,MainWindow^.borderLeft,MainWindow^.borderTop,DisplayWidth+5,103);
  352.     MainBorder:=CreateBorder(MainBorder,MainWindow^.borderLeft,MainWindow^.borderTop+103,DisplayWidth+5,FontSize+8);
  353.     DrawBorder(Rast,MainBorder,0,0);
  354.     Center(MainWindow,MainWindow^.borderTop+107,"MemWatcher by F.Brandau");
  355.   END;
  356.   |
  357.   | Add gadget
  358.   |
  359.   BaseGadget.nextGadget    := NIL;
  360.   BaseGadget.leftEdge      := MainWindow^.borderLeft+2;
  361.   BaseGadget.topEdge       := MainWindow^.borderTop+104;
  362.   BaseGadget.width         := DisplayWidth+1;
  363.   BaseGadget.height        := FontSize+6;
  364.   BaseGadget.flags         := gadgHComp;
  365.   BaseGadget.activation    := ActivationFlagSet:{relVerify};
  366.   BaseGadget.gadgetType    := boolGadget;
  367.   BaseGadget.gadgetRender  := NIL;
  368.   BaseGadget.selectRender  := NIL;
  369.   BaseGadget.gadgetText    := NIL;
  370.   BaseGadget.mutualExclude := {};
  371.   BaseGadget.specialInfo   := NIL;
  372.   BaseGadget.gadgetID      := 0;
  373.   BaseGadget.userData      := NIL;
  374.   FORGET AddGList(MainWindow,BaseGadget'PTR,65535,1,NIL);
  375.   RefreshGList(BaseGadget'PTR,MainWindow,NIL,-1);
  376.   |
  377.   | Set memorybase
  378.   |
  379.   MemBase:=AvailMem(MemReqSet:{});
  380.   |
  381.   | Draw baseline
  382.   |
  383.   SetAPen(MainWindow^.rPort,BlockPen);
  384.   Move(MainWindow^.rPort,MainWindow^.borderLeft+2,MainWindow^.borderTop+51);
  385.   Draw(MainWindow^.rPort,INTEGER(MainWindow^.borderLeft)+2+DisplayWidth,MainWindow^.borderTop+51);
  386.   oldX:=INTEGER(MainWindow^.borderLeft)+2+DisplayWidth;
  387.   oldY:=MainWindow^.borderTop+51;
  388.   |
  389.   | Main idcmp loop (action type)
  390.   |
  391.   WITH MainWindow^.userPort AS Port DO
  392.     REPEAT
  393.       DrawMem;
  394.       Delay(Time);
  395.       Msg:=GetMsg(Port);
  396.       IF Msg#NIL THEN
  397.         IF KEY Msg^.class
  398.           OF {closeWindow} THEN
  399.             EndPrg:=TRUE
  400.           END
  401.           OF {gadgetUp} THEN
  402.             MemBase:=AvailMem(MemReqSet:{})
  403.           END
  404.         END;
  405.         ReplyMsg(Msg)
  406.       END
  407.     UNTIL EndPrg
  408.   END;
  409.  
  410. CLOSE
  411.   IF MainWindow#NIL THEN
  412.     CloseWindow(MainWindow)
  413.   END;
  414.   IF DiskObjPtr#NIL THEN
  415.     FreeDiskObject(DiskObjPtr)
  416.   END;
  417.   OldDir:=CurrentDir(OldDir)
  418. END MemWatcher.
  419.